home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 090 / pctj8409.arc / PASCAL.ASM < prev    next >
Assembly Source File  |  1986-09-14  |  12KB  |  279 lines
  1.     .XLIST
  2. ;***********************************************************************;
  3. ;                                    ;
  4. ;PASCAL.MAC                                ;
  5. ;(C)(P)Copyright 1983 by Eric S. Raymond                ;
  6. ;       These macros are useful for generating ASM-86 routines that    ;
  7. ;    do stack-based argument handling, and can thus be treated like    ;
  8. ;    Pascal-86 or BASIC routines once declared in an interface or    ;
  9. ;    EXTERNed to. Note that they must be PUBLICed and live in a    ;
  10. ;    SEGMENT PUBLIC PARA 'CODE' to be accessible to the linker.    ;
  11. ;       These macros should work correctly with any compiler that    ;
  12. ;    a) only requires BP to be saved during subroutine calls, and    ;
  13. ;    b) pushes arguments left to right (last given is last pushed).    ;
  14. ;                                    ;
  15. ;I) General service routines                        ;
  16. ;    To generate a routine with a given profile of value and VAR    ;
  17. ;    args and a given service routine, write the following;        ;
  18. ;                                    ;
  19. ;[name]    PROC                                ;
  20. ;    PROLOG    <arg1, arg2,...argn>, tr                ;
  21. ;    [service code]                            ;
  22. ;    EPILOG    reg                            ;
  23. ;[name]    ENDP                                ;
  24. ;                                    ;
  25. ;    If A stands for an accumulator name, argk may have the form    ;
  26. ;       A  -- argument k is a value argument to be moved to A    ;
  27. ;       #A -- argument k is a CONST argument (input only)        ;
  28. ;       *A -- argument k is a VAR argument (output only)        ;
  29. ;       @A -- argument k is a VAR argument (input and output)    ;
  30. ;    For these four cases, PROLOG fetches argument k to A and EPILOG    ;
  31. ;    automatically stores A to it (if it's VAR).            ;
  32. ;       If argk has none of these forms, it is simply equated to k    ;
  33. ;    in the assembler's symbol tables, and can be used with GETVAL,    ;
  34. ;    GETVAR, and SETVAR to give the effect of named arguments.    ; 
  35. ;       If a register reg is specified, that register will be loaded    ;
  36. ;    into AL or AX (depending on length) just before exit and Pascal    ;
  37. ;    will see it as a return value. If reg is CY, AL will be loaded    ;
  38. ;    with 1 or 0 as the carry flag is on or off just before exit.    ;
  39. ;    Since the stack loads don't change the state of the flags, AL    ;
  40. ;    may pass out a VAR argument as usual before this.        ;
  41. ;       By default SI is used as a scratch register for locations of    ;
  42. ;    VAR arguments. This will lose if a VAR or CONST argument occurs    ;
  43. ;    after SI in the argument list. The optional second argument tr    ;
  44. ;    of PROLOG may be used to specify another scratch register; it    ;
  45. ;    may be SI, DI or BX and is passed to GETVAR and SETVAR.        ;
  46. ;                                    ;
  47. ;II) GETVAL, GETVAR and SETVAR                        ;
  48. ;    The macros GETVAL reg, k and GETVAR reg, k will load a register    ;
  49. ;    from the kth value or location argument respectively. The macro    ;
  50. ;    SETVAR k, reg will store REG to the kth by-location argument.    ;
  51. ;       GETVAR and SETVAR take an optional third argument which sets    ;
  52. ;    the location scratch register as described above.        ;
  53. ;                                    ;
  54. ;III) WITH1, WITH2                            ;
  55. ;    The macros WITH1 and WITH2 allow any instruction that will take    ;
  56. ;    the appropriate addressing mode to be applied to two operands,    ;
  57. ;    one of which is a stacked argument represented by its name. For    ;
  58. ;    example:                            ;
  59. ;       WITH2   CMP, AX, FOO                        ;
  60. ;    expands to CMP AX, [BP+X*2] where X is the stack offset of the    ;
  61. ;    argument named by FOO. WITH1 does this to its second argument,    ;
  62. ;    so WITH1   CMP, FOO, AX would be equivalent to the above.    ;
  63. ;                                    ;
  64. ;IV) SYS function calls                            ;
  65. ;      A macro has been included for generating interfaces to the    ;
  66. ;    PC's BIOS and DOS interrupt servers. With this macro,        ;
  67. ;                                    ;
  68. ;    SYS    name, int, func, <arg1, arg2,... argn>, reg, tr        ;
  69. ;                                    ;
  70. ;    generates source for a Pascal-accessible routine that executes    ;
  71. ;    PROLOG, does an INT (int) with (func) in AH, and then does    ;
  72. ;    EPILOG. Arguments in the bracketed list are loaded and returned    ;
  73. ;    as in PROLOG/EPILOG. Optional args reg and tr are as above.    ;
  74. ;       SYS will PUBLIC the generated function, though this won't    ;
  75. ;    be obvious in an .XALL listing since PUBLIC generates no code.    ;
  76. ;                                    ;
  77. ;***********************************************************************;
  78.  
  79.     .XCREF
  80.  
  81. INTFUN    MACRO    INTN, FUNCN    ;;Call a BIOS function
  82.     MOV    AH, FUNCN    ;; with given function number
  83.     INT    INTN        ;; and given interrupt
  84.     ENDM
  85.  
  86. ACOUNT    MACRO    ARG            ;;Counts arguments
  87.     IRP    REG, <AL,AH,BL,BH,CL,CH,DL,DH,AX,BX,CX,DX,SI,DI>
  88.     IFIDN    <ARG>, <REG>        ;;If it's a value argument
  89.     INCT    = INCT + 1        ;; bump the input argument count
  90.     EXITM                ;; then exit the IRP    
  91.     ENDIF                ;; else continue list check
  92.     IFIDN    <ARG>, <#®>        ;;If it's a CONST argument
  93.     INCT    = INCT + 1        ;; bump the input argument count
  94.     EXITM                ;; then exit the IRP
  95.     ENDIF                ;; else continue list check
  96.     IFIDN    <ARG>, <*®>        ;;If it's an output-only VAR arg
  97.     OUTCT    = OUTCT + 1        ;; bump the output argument count
  98.     EXITM                ;; then exit the IRP
  99.     ENDIF                ;; else continue list check
  100.     IFIDN    <ARG>, <@®>        ;;If it's a VAR argument
  101.     IOCT    = IOCT + 1        ;; bump the input/output arg count
  102.     EXITM                ;; then exit the IRP
  103.     ENDIF                ;; else continue list check
  104.     LACT    = LACT + 1        ;;It's a named argument
  105.     ENDM                ;;End of IRP
  106.     ENDM                ;;End of ACOUNT
  107.  
  108. GETVAL    MACRO    Z, N            ;;Load Nth value arg to Z
  109.     MOV    Z, [BP+2*(ARITY-N)+6]    ;;Move parameter to register
  110.     ENDM                ;;End of GETVAL
  111.  
  112. GETVAR    MACRO    Z, N, T            ;;Load Z to Nth VAR argument
  113.     IFB    <T>            ;;If no transport reg specified
  114.     MOV    SI, [BP+2*(ARITY-N)+6]    ;; fetch parameter address
  115.     MOV    Z, [SI]            ;; and load to where it points
  116.     ELSE                ;;Else transport register given
  117.     MOV    T, [BP+2*(ARITY-N)+6]    ;; fetch parameter address
  118.     MOV    Z, [T]            ;; and load to where it points
  119.     ENDM                ;;End of GETVAR
  120.  
  121. INARG    MACRO    FML, K, TR        ;;Generate stack fetch for arg K
  122. ;;First check the null case
  123.     IFB    <FML>            ;;If blank,
  124.     %OUT    K : skipped        ;; note: stack slot is skipped
  125.     EXITM                ;; and exit INARG
  126.     ENDIF                ;;End of blank check
  127. ;;Now look for a matching register argument
  128.     ISR    = 0            ;;No register match yet found
  129.     IRP    REG, <AL,AH,BL,BH,CL,CH,DL,DH,AX,BX,CX,DX,SI,DI,SP>
  130. ;;Handle value arguments
  131.     IFIDN    <FML>, <REG>        ;;If it's a value argument
  132.     ISR    = 1            ;; note that it matched
  133.     GETVAL    REG, K            ;; fetch it
  134.     %OUT    K : VAL REG         ;; and show it in the listing
  135.     EXITM                ;; then exit the IRP
  136.     ENDIF                ;; else continue list check
  137. ;;Handle CONST arguments
  138.     IFIDN    <FML>, <#®>        ;;If it's CONST
  139.     ISR    = 1            ;; note that it matched
  140.     GETVAR    REG, K, TR        ;; fetch Kth location arg
  141.     %OUT    K : CONST REG        ;; and show it in the listing
  142.     EXITM                ;; then exit the IRP
  143.     ENDIF                ;; else continue list check
  144. ;;Handle two-way VAR arguments
  145.     IFIDN    <FML>, <@®>        ;;If it's VAR
  146.     ISR    = 1            ;; note that it matched
  147.     GETVAR    REG, K, TR        ;; fetch Kth location arg
  148.     %OUT    K : VAR REG        ;; and show it in the listing
  149.     EXITM                ;; then exit the IRP
  150.     ENDIF                ;; else continue list check
  151. ;;Handle output VAR arguments
  152.     IFIDN    <FML>, <*®>        ;;If it's an output-only arg
  153.     ISR    = 1            ;; note that it matched
  154.     %OUT    K : VAR REG (out only)     ;; show it in the listing
  155.     EXITM                ;; then exit the IRP
  156.     ENDIF                ;; else continue list check
  157.     ENDM                ;;End of IRP
  158. ;;If no matching register arg, equate name to arg number
  159.     IFE    ISR            ;;No register argument match
  160.     FML    = K            ;;Equate name to arg value
  161.     %OUT    K : FML = K        ;;Report the action
  162.     ENDIF                ;;End of symbol check
  163.     ENDM                ;;End of INARG
  164.  
  165. PROLOG    MACRO    ARGS, TR    ;;Process input arguments
  166.     .XCREF            ;;Don't need generated code to be CREFed
  167.     ARITY    = 0        ;;Start with 0 total arguments
  168.     INCT    = 0        ;;Start with 0 input args
  169.     OUTCT    = 0        ;;Start with 0 output args
  170.     IOCT    = 0        ;;Start with 0 input/output args
  171.     LACT    = 0        ;;Start with 0 named arguments
  172.     IRP    X, <ARGS>    ;;Count the flavors of arguments
  173.     ARITY    = ARITY + 1    ;; ARITY counts all four kinds
  174.     ACOUNT    X        ;; Now count the individual kinds
  175.     ENDM            ;;End of argument count loop
  176.     PUSH    BP        ;;Save that frame pointer
  177.     IF    INCT+IOCT+LACT    ;;If there are input args
  178.     MOV    BP, SP        ;; set up for stack access
  179.     C    = 0        ;; initialize argument count
  180.     IRP    X, <ARGS>    ;; and loop through the argument list
  181.     C    = C + 1        ;; using C to count from 1 to ARITY
  182.     INARG    X, %C, TR    ;; generating stack fetches as we go
  183.     ENDM            ;;End of argument-list processing loop
  184.     ENDIF            ;;End of 'if there are input args'
  185. EPILOG    MACRO    REG        ;;Generate EPILOG macro
  186.     ENDF    <ARGS>, REG, TR    ;;Have it call ENDF with ARGLIST
  187.     ENDM            ;;End of generated macro
  188.     .CREF            ;;Restore CREF
  189.     ENDM            ;;End of PROLOG
  190.  
  191. SETVAR    MACRO    N, Z, T            ;;Store Z to Nth VAR argument
  192.     IFB    <T>            ;;If no transport reg specified
  193.     MOV    SI, [BP+2*(ARITY-N)+6]    ;; fetch parameter address
  194.     MOV    [SI], Z            ;; and load to where it points
  195.     ELSE                ;;Else transport register given
  196.     MOV    T, [BP+2*(ARITY-N)+6]    ;; fetch parameter address
  197.     MOV    [T], Z            ;; and load to where it points
  198.     ENDM                ;;End of SETVAR
  199.  
  200. OUTARG    MACRO    K, FML, TR        ;;Gen stack load for Kth VAR arg
  201.     IFNB    <FML>            ;;If blank, do nothing
  202.     IRP    REG, <AL,AH,AX,BL,BH,BX,CL,CH,CX,DL,DH,DX>
  203.     IFIDN    <FML>, <*®>        ;;If it's an output-only arg
  204.     SETVAR    K, REG, TR        ;; store to its location
  205.     EXITM                ;; then exit the IRP
  206.     ENDIF                ;; else continue list check
  207.     IFIDN    <FML>, <@®>        ;;If it's a VAR argument
  208.     SETVAR    K, REG, TR        ;; store to its location
  209.     EXITM                ;; then exit the IRP
  210.     ENDIF                ;; else continue list check
  211.     ENDM                ;;End of IRP
  212.     ENDIF                ;;Skip if <ARG> is blank
  213.     ENDM                ;;End of OUTARG
  214.  
  215. MOVACC    MACRO    REG            ;;Gen code to move REG to AL/AX
  216.     %OUT    REG value returned    ;;Show it in the listing
  217.     IFDIF    <RETREG>, <AX>        ;;Skip the rigamarole if it's AX
  218.     IFDIF    <RETREG>, <AL>        ;;  likewise if it's AL
  219.     IRP    X, <AH,CH,DH,BH,CL,DL,BL>    ;;Try 8-bit registers
  220.     IFIDN    <REG>, <X>        ;;If REG is one
  221.     MOV    AL, REG            ;; then move it to AL
  222.     EXITM                ;; then exit the IRP
  223.     ENDIF                ;; else try the next one
  224.     ENDM                ;;End of 8-bit register IRP
  225.     IRP    X, <CX,DX,BX,SI,DI,BP,SP>    ;;Try 16-bit registers
  226.     IFIDN    <REG>, <X>        ;;If REG is one
  227.     MOV    AX, REG            ;; then move it to AX
  228.     EXITM                ;; then exit the IRP
  229.     ENDIF                ;; else try the next one
  230.     ENDM                ;;End of 16-bit register IRP
  231.     IFIDN    <REG>, <CY>        ;;Should carry flag be returned?
  232.     XOR    AL, AL            ;; If so, zero AL
  233.     RCR    AL            ;; and rotate in the carry bit
  234.     ENDIF                ;;End of carry bit processing
  235.     ENDIF                ;;Skip here if RETREG was AL
  236.     ENDIF                ;;Skip here if RETREG was AX
  237.     ENDM                ;;End of MOVACC
  238.  
  239. ENDF    MACRO    ARGS,RETREG,TR    ;;Gen stack loads and RET for routine
  240.     .XCREF            ;;Don't need cross-referencing here
  241.     IF    OUTCT + IOCT    ;;If there are output arguments
  242.     MOV    BP, SP        ;; set up for stack access
  243.     C    = 0        ;; initialize arg ctr
  244.     IRP    X, <ARGS>    ;; and loop through it,
  245.     C    = C + 1        ;; using C to count from 1 to ARITY
  246.     OUTARG    %C, X, TR    ;; generating stack loads as we go
  247.     ENDM            ;;End of argument list processing loop
  248.     ENDIF            ;;Now handle the return
  249.     IFNB    <RETREG>    ;;If a return reg has been specified
  250.     MOVACC    RETREG        ;;  generate code to move it to AL or AX
  251.     ENDIF            ;;skip here if RETREG was blank
  252.     POP    BP        ;;Restore frame ptr
  253.     RET    2*ARITY        ;;Clean args off stack
  254.     %OUT            ;;Make spacing blank line in listing
  255.     .CREF            ;;Restore cross-ref'ing for next routine
  256.     ENDM            ;;End of ENDF
  257.  
  258. WITH1    MACRO    OP, K, ARG        ;;Apply OP to 
  259.     OP    [BP+2*(ARITY-K)+6], ARG    ;;Kth stack entry & ARG
  260.     ENDM                ;;End of WITH1
  261.  
  262. WITH2    MACRO    OP, ARG, K        ;;Apply OP to 
  263.     OP    ARG, [BP+2*(ARITY-K)+6]    ;;ARG & Kth stack entry
  264.     ENDM                ;;End of WITH2
  265.  
  266. SYS    MACRO    NAME, INTN, FUNCN, ARGS, REG    ;;Gen SYS call interface
  267.     %OUT    NAME        ;;Let user know we're here
  268.     PUBLIC    NAME        ;;Make sure proc is accessible to Pascal
  269. NAME    PROC    FAR        ;;Start of generated procedure
  270.     PROLOG    <ARGS>        ;;Count & fetch input arguments
  271.     INTFUN    INTN, FUNCN    ;;Call the interrupt function
  272.     EPILOG    REG        ;;Call the macro generated by PROLOG
  273. NAME    ENDP            ;;End of generated procedure
  274.     ENDM            ;;End of SYS
  275.  
  276.     .LALL
  277.     .CREF
  278.     .LIST
  279.